home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / fcsrc.exe / FCDLGS.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-04  |  15KB  |  542 lines
  1. unit FCDLGS;
  2.  
  3. {$R FCDLGS}
  4.  
  5. interface
  6.  
  7. uses WinTypes, WinProcs, WObjects, WinDOS, Strings;
  8.  
  9. {$I fc.inc}
  10.  
  11. const
  12.     id_DirDlg                    = 400;
  13.     id_DirListbox            = 401;
  14.     id_DirPrompt            = 402;
  15.  
  16.     id_ExeDlg                    = 410;
  17.     id_ExePrompt            = 411;
  18.     id_ExeFilebox            = 412;
  19.     id_ExeDirbox            = 413;
  20.     id_ExeFilePrompt    = 414;
  21.  
  22.   id_SaveAsDlg            = 420;
  23.   id_Namebox                = 421;
  24.  
  25.   id_SctnDlg                 = 430;
  26.     id_SctnList             = 431;
  27.  
  28.   id_SetupDlg                = 440;
  29.   id_ItmEdit                = 441;
  30.   id_GrpCombo                = 442;
  31.   id_InstallBtn            = 443;
  32.  
  33. type
  34.     PDirDlg    = ^TDirDlg;
  35.     TDirDlg    = object(TDialog)
  36.         Buffer: PChar;
  37.         constructor Init(AParent: PWindowsObject; ABuffer: PChar);
  38.         procedure SetupWindow; virtual;
  39.         procedure MsgDirListbox(var Msg: TMessage);
  40.         virtual id_First + id_DirListbox;
  41.     procedure Ok(var Msg: TMessage); virtual id_First + id_Ok;
  42.      end;
  43.  
  44.     PExeDlg = ^TExeDlg;
  45.     TExeDlg = object(TDialog)
  46.         Buffer: PChar;
  47.     FileBox: PListBox;
  48.         constructor Init(AParent: PWindowsObject; ABuffer: PChar);
  49.         procedure SetupWindow; virtual;
  50.         procedure MsgExeFilebox(var Msg: TMessage);
  51.         virtual id_First + id_ExeFilebox;
  52.         procedure MsgExeDirbox(var Msg: TMessage);
  53.         virtual id_First + id_ExeDirbox;
  54.     procedure Ok(var Msg: TMessage);
  55.         virtual id_First + id_Ok;
  56.     end;
  57.  
  58.   PSaveAsDlg = ^TSaveAsDlg;
  59.   TSaveAsDlg = object(TDialog)
  60.       Buffer: PChar;
  61.     NameBox: PEdit;
  62.     constructor Init(AParent: PWindowsObject; ABuffer: PChar);
  63.     procedure SetupWindow; virtual;
  64.     function CanClose: Boolean; virtual;
  65.   end;
  66.  
  67. type
  68.     PSctnDlg = ^TSctnDlg;
  69.     TSctnDlg = object(TDialog)
  70.     Buffer: PChar;
  71.     BufferSize: Word;
  72.     SctnList: PListbox;
  73.     OkBtn: PButton;
  74.     constructor Init(AParent: PWindowsObject; ABuffer: PChar;
  75.         ABufferSize: Word);
  76.     function CanClose: Boolean; virtual;
  77.         procedure SetupWindow; virtual;
  78.         procedure CMSctnList(var Msg: TMessage);
  79.         virtual id_First + id_SctnList;
  80.   end;
  81.  
  82.     PPmGroup = ^TPmGroup;
  83.     TPmGroup = object(TObject)
  84.         Filename: Array[0..100] of Char;
  85.         Title   : Array[0..100] of Char;
  86.         constructor Init;
  87.         procedure NextGroup(AFilename: PChar);
  88.     end;
  89.  
  90.   PInstallDlg = ^TInstallDlg;
  91.   TInstallDlg = object(TDialog)
  92.       SectionName: PChar;
  93.     TheItm, TheGrp: PChar;
  94.       ItmEdit: PEdit;
  95.     GrpCombo: PCombobox;
  96.     ServerWindow: HWnd;
  97.     PendingMessage: Word;
  98.       constructor Init(AParent: PWindowsObject;
  99.         ASectionName, AnItm, AGrp: PChar);
  100.     procedure SetupWindow; virtual;
  101.     procedure CMInstall(var Msg: TMessage);
  102.         virtual id_First + id_InstallBtn;
  103.     procedure WMDDEAck(var Msg: TMessage);
  104.         virtual wm_First + wm_DDE_Ack;
  105.     procedure WMDDETerminate(var Msg: TMessage);
  106.         virtual wm_First + wm_DDE_Terminate;
  107.     procedure WMDestroy(var Msg: TMessage);
  108.         virtual wm_First + wm_Destroy;
  109.     procedure InitiateDDE;
  110.     procedure TerminateDDE;
  111.   end;
  112.  
  113. implementation
  114.  
  115. { ----- TDirDlg methods ---------------------------------------------- }
  116.  
  117. constructor TDirDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
  118. var
  119.     AControl: PControl;
  120. begin
  121.     TDialog.Init(AParent, PChar(id_DirDlg));
  122.   Buffer := ABuffer;
  123.     AControl := New(PListBox, InitResource(@Self, id_DirListbox));
  124.   AControl := New(PStatic, InitResource(@Self, id_DirPrompt,
  125.       fsPathName+1));
  126. end;
  127.  
  128. procedure TDirDlg.SetupWindow;
  129. begin
  130.     DlgDirList(HWindow, GetCurDir(Buffer, 0), id_DirListbox,
  131.       id_DirPrompt, $C010);
  132. end;
  133.  
  134. procedure TDirDlg.MsgDirListbox(var Msg: TMessage);
  135. begin
  136.     if Msg.LParamHi = lbn_DblClk then
  137.     begin
  138.         DlgDirSelect(HWindow, Buffer, id_DirListbox);
  139.         FileExpand(Buffer, Buffer);
  140.         DlgDirList(HWindow, Buffer, id_DirListbox, id_DirPrompt, $C010);
  141.     end;
  142. end;
  143.  
  144. procedure TDirDlg.Ok(var Msg: TMessage);
  145. var
  146.     Len: Integer;
  147. begin
  148.     Buffer[0] := #0;
  149.     DlgDirSelect(HWindow, Buffer, id_DirListbox);
  150.   if StrIComp(Buffer, '') = 0 then
  151.   begin
  152.       FileExpand(Buffer, Buffer);
  153.       Len := StrLen(Buffer) - 1;
  154.       if Buffer[Len] = '\' then
  155.           Buffer[Len] := #0;
  156.       TDialog.Ok(Msg);
  157.   end
  158.   else
  159.   begin
  160.         FileExpand(Buffer, Buffer);
  161.         DlgDirList(HWindow, Buffer, id_DirListbox, id_DirPrompt, $C010);
  162.     end;
  163. end;
  164.  
  165. { ---- TExeDlg methods -------------------------------------------------- }
  166.  
  167. constructor TExeDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
  168. var
  169.     AControl: PControl;
  170. begin
  171.     TDialog.Init(AParent, PChar(id_ExeDlg));
  172.     Buffer := ABuffer;
  173.   FileBox := New(PListBox, InitResource(@Self, id_ExeFilebox));
  174.     AControl := New(PListBox, InitResource(@Self, id_ExeDirbox));
  175.     AControl := New(PStatic, InitResource(@Self, id_ExePrompt,
  176.       fsPathName+1));
  177.   AControl := New(PStatic, InitResource(@Self, id_ExeFilePrompt,
  178.       fsPathName+1));
  179. end;
  180.  
  181. procedure TExeDlg.SetupWindow;
  182. var
  183.     FileSpec: array[0..10] of Char;
  184. begin
  185.     DlgDirList(HWindow, GetCurDir(Buffer, 0), id_ExeDirbox, id_ExePrompt,
  186.       $C010);
  187.     DlgDirList(HWindow, '*.exe', id_ExeFilebox, id_ExeFilePrompt, $0000);
  188.     StrCopy(FileSpec, '*.com');
  189.     SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
  190.       Longint(@FileSpec));
  191.     StrCopy(FileSpec, '*.bat');
  192.     SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
  193.       Longint(@FileSpec));
  194.     StrCopy(FileSpec, '*.pif');
  195.     SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000,
  196.       Longint(@FileSpec));
  197. end;
  198.  
  199. procedure TExeDlg.MsgExeDirbox(var Msg: TMessage);
  200. begin
  201.     if Msg.LParamHi = lbn_DblClk then
  202.       TExeDlg.Ok(Msg);
  203. end;
  204.  
  205. procedure TExeDlg.MsgExeFilebox(var Msg: TMessage);
  206. begin
  207.     if Msg.LParamHi = lbn_DblClk then
  208.         TExeDlg.Ok(Msg);
  209. end;
  210.  
  211. procedure TExeDlg.Ok(var Msg: TMessage);
  212. var
  213.     FileSpec: array[0..10] of Char;
  214.     Len: Integer;
  215. begin
  216.     Buffer[0] := #0;
  217.   DlgDirSelect(HWindow, Buffer, id_ExeDirbox);
  218.   if StrIComp(Buffer, '') > 0 then
  219.   begin
  220.         FileExpand(Buffer, Buffer);
  221.         DlgDirList(HWindow, Buffer, id_ExeDirbox, id_ExePrompt, $C010);
  222.         DlgDirList(HWindow, '*.exe', id_ExeFilebox, id_ExeFilePrompt, $0000);
  223.         StrCopy(FileSpec, '*.com');
  224.         SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
  225.         StrCopy(FileSpec, '*.bat');
  226.         SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
  227.         StrCopy(FileSpec, '*.pif');
  228.         SendDlgItemMessage(HWindow, id_ExeFilebox, LB_DIR, $0000, Longint(@FileSpec));
  229.     end
  230.   else
  231.   begin
  232.       DlgDirSelect(HWindow, Buffer, id_ExeFilebox);
  233.     if StrIComp(Buffer, '') > 0 then
  234.     begin
  235.         FileExpand(Buffer, Buffer);
  236.         Len := StrLen(Buffer) - 1;
  237.         if Buffer[Len] = '\' then
  238.             Buffer[Len] := #0;
  239.         TDialog.Ok(Msg);
  240.     end;
  241.   end;
  242. end;
  243.  
  244. { ---- TSaveAsDlg methods ---------------------------------------------- }
  245.  
  246. constructor TSaveAsDlg.Init(AParent: PWindowsObject; ABuffer: PChar);
  247. begin
  248.     TDialog.Init(AParent, PChar(id_SaveAsDlg));
  249.   Buffer := ABuffer;
  250.     NameBox := New(PEdit, InitResource(@Self, id_Namebox, PrgManItm+1));
  251. end;
  252.  
  253. procedure TSaveAsDlg.SetupWindow;
  254. begin
  255.     TDialog.SetupWindow;
  256.   NameBox^.Insert(Buffer);
  257. end;
  258.  
  259. function TSaveAsDlg.CanClose: Boolean;
  260. begin
  261.     NameBox^.GetText(Buffer, PrgManItm+1);
  262.   if StrIComp(Buffer, ' ') < 1 then
  263.       CanClose := FALSE
  264.   else
  265.       CanClose := TRUE;
  266. end;
  267.  
  268. { ---- TSctnDlg methods ------------------------------------------------ }
  269.  
  270. constructor TSctnDlg.Init(AParent: PWindowsObject; ABuffer: PChar;
  271.     ABufferSize: Word);
  272. begin
  273.     TDialog.Init(AParent, PChar(id_SctnDlg));
  274.   Buffer := ABuffer;
  275.   BufferSize := ABufferSize;
  276.     SctnList := New(PListbox, InitResource(@Self, id_SctnList));
  277.   OkBtn := New(PButton, InitResource(@Self, id_Ok));
  278. end;
  279.  
  280. procedure TSctnDlg.SetupWindow;
  281. var
  282.     AFile: Text;
  283.   FullIniName: array[0..fsPathName] of Char;
  284.     Buf, OutBuf: array[0..160] of Char;
  285.     i, Len: Integer;
  286.   SectionsFound: boolean;
  287. begin
  288.     TDialog.SetupWindow;
  289.   GetWindowsDirectory(FullIniName, fsPathName+1);
  290.   StrLCat(FullIniName, '\', fsPathName+1);
  291.   StrLCat(FullIniName, IniName, fsPathName+1);
  292.   {$I-}
  293.     assign(AFile, FullIniName);
  294.     Reset(AFile);
  295.   {$I+}
  296.   if IOResult <> 0 then
  297.   begin
  298.       StrLCopy(Buf, 'File Clerk could not find ', 160);
  299.     StrLCat(Buf, StrUpper(IniName), 160);
  300.     StrLCat(Buf, '. It made a new copy in the Windows directory.', 160);
  301.       Me